perm filename LIB.LST[P,JRA] blob
sn#513118 filedate 1979-05-06 generic text, type T, neo UTF8
PASCAL COMPILATION LIST PRODUCED BY PASCAL VERSION FROM 30-DEC-76 ON 06-MAY-79 AT 12:35:34
10 COMMENT VALID 00002 PAGES
20 C REC PAGE DESCRIPTION
30 C00001 00001
40 C00002 00002 (*$E+*)
50 C00027 ENDMK
60 C;
70 (*$E+*)
80 (*PASCAL PROGRAMS*)
90 PROGRAM JUNK,UNIFY,SUBST,REPLACE,COPYTERMLIST,COPYTERM,COPYCONST,COPYSYM;
100 (*PASCAL CAN'T HANDLE THINGS THE WAY IT SHOULD SO WE HAVE TO INVENT STRANGE
110 NAMES THAT ARE ALL REFERRING TO THE SAME THING, IN PARTICULAR, THE TYPE
120 OF THE OBJECT AT HAND. THUS,
130 ALLTYPS, AN INDICATION OF THE POSSIBLE ATOMIC TYPES, IS ACTUALLY MADE
140 UP OF CONVOLUTED VERSIONS OF THE TYPE NAMES.
150 THIS IDIOCY IS CARRIED ON THROUGHOUT, WHICH IS WHY YOU'LL SEE SEVERAL
160 DIFFERENT NAMES THAT ALL LOOK SIMILAR BUT HAD TO BE DIFFERENT FOR PASCAL. *)
170
180 TYPE
190 (* ALLTYPS ARE THE TYPES OF ATOMIC CONSTANTS *)
200 ALLTYPS = (INTEGERTYP, REALTYP, BOOLEANTYP, CHARTYP, SYMBOLTYP);
210
220 TERMTYPS = (VARIABLE, CONSTANTTYP, FUNAPP);
230
240 TERM = ↑T1;
250
260 TERMLIST = ↑TL1;
270
280 CONSTANT = ↑C1;
290
300 SYMBOL = ↑SYM1;
310
320 T1 = RECORD
330 CASE TTYP:TERMTYPS OF
340 VARIABLE: (VR: INTEGER);
350 CONSTANTTYP: (CNST: CONSTANT);
360 FUNAPP: (FNAME: SYMBOL;
370 ARGS: TERMLIST)
380 END;
390
400 TL1 = RECORD
410 NOTEMPTY: BOOLEAN;
420 FIRST: TERM;
430 REST: TERMLIST
440 END;
450
460
470 (*CHANGED AGAIN: A VARIABLE IS JUST AN INTEGER, SERVES FINE FOR
480 COMPARISON AND WE NEVER PRINT THEM OUT ANYWAY*)
490
500 (* VARIABLE = SYMBOL; *) (*VARS HAVE NAMES AND ARE FREE, WHEN THEY
510 GET BOUND THEY ARE REPLACED BY OTHER TERMS*)
520
530 (* VARIABLE = ↑V1;
540
550 V1 = RECORD
560 BOUND: BOOLEAN;
570 PNAME: SYMBOL;
580 CASE VTYP:ALLTYPS OF
590 INTEGER: (IVAL: INTEGER);
600 REAL: (RVAL: REAL);
610 BOOLEAN: (BVAL: BOOLEAN);
620 CHAR: (CVAL: CHAR);
630 TERM: (TVAL: TERM)
640 END; *)
650
660 C1 = RECORD
670 CASE CTYP:ALLTYPS OF
680 INTEGERTYP: (IVAL: INTEGER);
690 REALTYP: (RVAL: REAL);
700 BOOLEANTYP: (BVAL: BOOLEAN);
710 CHARTYP: (CVAL: CHAR);
720 SYMBOLTYP: (SVAL: SYMBOL)
730 END;
740
750 SYM1 = RECORD
760 NOTEMPTY: BOOLEAN;
770 FIRSTCH: CHAR;
780 TAIL: SYMBOL
790 END;
800
810 VARPAIRS = ↑VP;
820
830 VP = RECORD
840 NOTEMPTY: BOOLEAN;
850 OLD: INTEGER;
860 NEW: INTEGER;
870 REST: VARPAIRS
880 END;
890
900
910 (* SINGLESUB = ↑SS1;
920
930 SS1 = RECORD
940 VR: VARIABLE;
950 TM: TERM
960 END;
970
980 SUB = ↑S1;
990
1000 S1 = RECORD
1010 FAILED: BOOLEAN;
1020 ISEMPTY: BOOLEAN;
1030 FIRST: SINGLESUB;
1040 REST: SUB
1050 END;
1060 *)
1070
1080 (*VAR X1, Y1: TERMLIST;
1090 X2, Y2: TERM;
1100 S2: SUB;
1110 BEGIN
1120 *INITIALIZE: S GETS THE EMPTY SUBSTITUTION*
1130 NEW(S);
1140 S↑.ISEMPTY := TRUE;
1150 S↑.FAILED := FALSE;
1160 X1 := X; (*THESE ARE HERE BECAUSE THEY WERE IN FWH'S VERSION*
1170 Y1 := Y;
1180 WHILE X1↑.NOTEMPTY AND Y1↑.NOTEMPTY AND NOT(S↑.FAILED) DO
1190 BEGIN
1200 TERMSUBST( X1↑.FIRST, S, X2);
1210 TERMSUBST( Y1↑.FIRST, S, Y2);
1220 IF X2↑.TTYP = VARIABLE
1230 THEN BEGIN
1240 IF Y2↑.TTYP = VARIABLE
1250 THEN BEGIN
1260 IF NOT( EQSYM(X2↑.VR↑.PNAME, Y2↑.VR↑.PNAME) )
1270 (*PASCAL CAN'T HANDLE THIS COMPARISON ITSELF, RECORDS,YOU KNOW*
1280 THEN COMPOSESUB( S, PAIR(X2↑.VR, Y2));
1290 (*IF THEY ARE THE SAME VARIABLE THEN NOTHING NEED BE DONE*
1300 END
1310 ELSE IF OCCUR(X2, Y2)
1320 THEN S↑.FAILED := TRUE
1330 ELSE COMPOSESUB( S, PAIR(X2↑.VR, Y2))
1340 END
1350 ELSE IF Y2↑.TTYP = VARIABLE
1360 THEN BEGIN
1370 IF OCCUR(Y2, X2)
1380 THEN S↑.FAILED := TRUE
1390 ELSE COMPOSESUB(S, PAIR(Y2↑.VR, X2))
1400 END
1410 ELSE IF X2↑.TTYP = CONSTANT
1420 THEN BEGIN
1430 IF Y2↑.TTYP = CONSTANT
1440 THEN BEGIN
1450 IF NOT( EQCONST(X2↑.CNST, Y2↑.CNST) )
1460 THEN S↑.FAILED := TRUE;
1470 (*IF THEY ARE = NOTHING NEED BE DONE*
1480 END
1490 ELSE IF X2↑.CNST↑.CTYP = TERM
1500 THEN BEGIN
1510 MATCHCONST(X2↑.CONST↑.TVAL, Y2, S2);
1520 IF S2↑.FAILED
1530 THEN S↑.FAILED := TRUE
1540 ELSE COMPOSESUB (S, S2)
1550 END
1560 ELSE S↑.FAILED := TRUE;
1570 (*ANY OTHER KIND OF CONSTANT COULD ONLY
1580 MATCH WITH A VARIABLE*
1590 END
1600 ELSE (*X2 IS A FUNAPP (THUS OF TYPE TERM) AND Y2 IS NOT A VARIABLE
1610 IF Y2↑.TTYP = CONSTANT
1620 THEN BEGIN
1630 IF Y2↑.CNST↑.CTYP = TERM
1640 THEN BEGIN
1650 MATCHCONST(Y2↑.CNST↑.TVAL, X2, S2);
1660 IF S2↑.FAILED
1670 THEN S↑.FAILED := TRUE
1680 ELSE COMPOSESUB(S, S2)
1690 END
1700 ELSE S↑.FAILED := TRUE
1710 END
1720 ELSE (*X2 AND Y2 ARE BOTH FUNAPP TERMS*
1730 IF EQSYM(X2↑.FNAME, Y2↑.FNAME)
1740 THEN BEGIN
1750 UNIFY(X2↑.ARGS, Y2↑.ARGS, S2);
1760 IF S2↑.FAILED
1770 THEN S↑.FAILED := TRUE
1780 ELSE COMPOSESUB(S, S2)
1790 END
1800 ELSE S↑.FAILED :=TRUE;
1810 X1 := X1↑.REST;
1820 Y1 := Y1↑.REST
1830 END; (*OF WHILE*
1840 IF X1↑.NOTEMPTY OR Y1↑.NOTEMPTY THEN S↑.FAILED := TRUE
1850 END; (*OF UNIFY*
1860 *)
1870 (*UNIFY SIDE EFFECTS ITS ARGS ALL OVER THE PLACE, THE ORIGINALS ARE COPIED BEFORE
1880 THE CALL IS MADE*)
1890 (*
1900 PROCEDURDαUNIFY(VAR X, Y: TERMLIST; FAILED:BOOLEAN);
1910 VAR X1, Y1: TERMLIST;
1920 X2, Y2: TERM;
1930 SUBFAILED: BOOLEAN;
1940 BEGIN
1950 (*INITIALIZE*
1960 FAILED := FALSE;
1970 X1 := X;
1980 Y1 := Y;
1990 WHILE X1↑.NOTEMPTY AND Y1↑.NOTEMPTY AND NOT(FAILED) DO
2000 BEGIN
2010 X2 := X1↑.FIRST;
2020 Y2 := Y1↑.FIRST;
2030 IF X2↑.TTYP = VARIABLE
2040 THEN BEGIN
2050 IF Y2↑.TTYP = VARIABLE
2060 THEN X2↑.VR↑.PNAME := Y2↑.VR↑.PNAME
2070 (* IF THEY'RE ALREADY THE SAME, THE ASSIGNMENT IS UNNECESSARY
2080 BUT CHEAPER THAN TESTING THE EQUALITY AND WON'T HURT ANYTHING*
2090 ELSE IF OCCUR(X2, Y2)
2100 THEN FAILED := TRUE
2110 ELSE SUBST(X2↑.VR, Y2, X, Y)
2120 END
2130 ELSE IF Y2↑.TTYP = VARIABLE
2140 THEN BEGIN
2150 IF OCCUR(Y2, X2)
2160 THEN FAILED := TRUE
2170 ELSE SUBST(Y2↑.VR, X2, X, Y)
2180 END
2190 ELSE IF X2↑.TTYP = CONSTANT
2200 THEN BEGIN
2210 IF Y2↑.TTYP = CONSTANT
2220 THEN BEGIN
2230 IF NOT( EQCONST(X2↑.CNST, Y2↑.CNST) )
2240 THEN FAILED := TRUE;
2250 (*IF THEY ARE = NOTHING NEED BE DONE*
2260 END
2270 ELSE IF X2↑.CNST↑.CTYP = TERM
2280 THEN BEGIN
2290 MATCHCONST(X2↑.CONST↑.TVAL, Y2, X, Y, SUBFAILED);
2300 IF SUBFAILED
2310 THEN FAILED := TRUE
2320 END
2330 ELSE FAILED := TRUE;
2340 (*ANY OTHER KIND OF CONSTANT COULD ONLY
2350 MATCH WITH A VARIABLE*
2360 END
2370 ELSE (*X2 IS A FUNAPP (THUS OF TYPE TERM) AND Y2 IS NOT A VARIABLE*
2380 IF Y2↑.TTYP = CONSTANT
2390 THEN BEGIN
2400 IF Y2↑.CNST↑.CTYP = TERM
2410 THEN BEGIN
2420 MATCHCONST(Y2↑.CNST↑.TVAL, X2, X, Y, SUBFAILED);
2430 IF SUBFAILED
2440 THEN FAILED := TRUE
2450 END
2460 ELSE FAILED := TRUE
2470 END
2480 ELSE (*X2 AND Y2 ARE BOTH FUNAPP TERMS*
2490 IF EQSYM(X2↑.FNAME, Y2↑.FNAME)
2500 THEN BEGIN
2510 UNIFY(X2↑.ARGS, Y2↑.ARGS, SUBFAILED);
2520 IF SUBFAILED
2530 THEN FAILED := TRUE
2540 END
2550 ELSE FAILED :=TRUE;
2560 X1 := X1↑.REST;
2570 Y1 := Y1↑.REST
2580 END; (*OF WHILE*
2590 IF X1↑.NOTEMPTY OR Y1↑.NOTEMPTY THEN FAILED := TRUE
2600 END; (*OF UNIFY*
2610 *)
2620
2630 (* THE TRUE GLORY OF THE NEW TYPE DEFS SHOWS UP HERE... NO MATCHCONST IS NECESSARY!
2640 PROCEDURE MATCHCONST(X, Y, ALLX, ALLY: TERM; VAR FAILED: BOOLEAN);
2650 VAR X1, Y1: TERMLIST;
2660 SUBFAILED: BOOLEAN;
2670 BEGIN
2680 FAILED := FALSE;
2690 IF Y↑.TTYP = VARIABLE
2700 THEN SUBST(Y↑.VR, X, ALLX, ALLY)
2710 ELSE IF Y↑.TTYP = CONSTANT
2720 THEN BEGIN
2730 IF NOT(EQCONST(X, Y↑.CNST))
2740 THEN FAILED := TRUE
2750 END (*IF THEY'RE THE SAME THEN NOTHING NEED BE DONE*
2760 ELSE IF X↑.TTYP = FUNAPP
2770 THEN BEGIN
2780 IF EQSYM(Y↑.FNAME, X↑.FNAME)
2790 THEN BEGIN
2800 X1 := X↑.ARGS;
2810 Y1 := Y↑.ARGS;
2820 WHILE X1↑.NOTEMPTY AND Y1↑.NOTEMPTY AND NOT(FAILED)
2830 DO BEGIN
2840 MATCHCONST(X1↑.FIRST, Y1↑.FIRST, ALLX, ALLY, SUBFAILED);
2850 IF SUBFAILED
2860 THEN FAILED := TRUE
2870 END
2880 END
2890 ELSE FAILED := TRUE
2900 END
2910 ELSE FAILED := TRUE
2920 END; (*MATCHCONST*
2930 *)
2940
2950 FUNCTION GENVAR:INTEGER;
2960 BEGIN
2970 GENVAR:= REALTIME
2980 END;(*GENVAR*)
2990
3000 FUNCTION OCCUR(X,Y:TERM):BOOLEAN;
3010 VAR PTR: TERMLIST;
3020 FLAG: BOOLEAN;
3030 BEGIN
3040 IF Y↑.TTYP = VARIABLE
3050 THEN BEGIN
3060 IF Y↑.VR = X↑.VR
3070 THEN OCCUR := TRUE
3080 ELSE OCCUR := FALSE
3090 END
3100 ELSE IF Y↑.TTYP = CONSTANTTYP
3110 THEN OCCUR := FALSE
3120 ELSE BEGIN
3130 PTR := Y↑.ARGS;
3140 FLAG := FALSE;
3150 WHILE PTR↑.NOTEMPTY AND (FLAG = FALSE)
3160 DO BEGIN
3170 FLAG := OCCUR(X, PTR↑.FIRST);
3180 PTR := PTR↑.REST
3190 END;
3200 OCCUR := FLAG
3210 END
3220 END;(*OCCUR*)
3230
3240
3250 PROCEDURE REPLACE(X, T: TERM; VAR TML: TERMLIST);
3260 VAR TL1:TERMLIST;
3270 T1:TERM;
3280 BEGIN
3290 TL1:= TML;
3300 WHILE TL1↑.NOTEMPTY DO
3310 BEGIN
3320 T1 := TL1↑.FIRST;
3330 IF NOT(T1↑.TTYP = CONSTANTTYP)
3340 THEN BEGIN
3350 IF T1↑.TTYP = VARIABLE
3360 THEN BEGIN
3370 IF X↑.VR = T1↑.VR
3380 THEN (*T1 GETS T, BUT I DONT THINK AN ASSIGNMENT WILL WORK;
3390 TRY IT ANYWAY, THINK ABOUT IT LATER*)
3400 TL1↑.FIRST := T (*NEED TO MUNG RECORD, NOT JUST PTR T1*)
3410 (*ELSE, NO CHANGE NEEDED*)
3420 END
3430 ELSE (*IT'S A FUNAPP*)
3440 REPLACE(X, T, TL1↑.FIRST↑.ARGS)
3450 END;
3460 (*IF ITS A CONSTANT NO CHANGES NEED BE MADE*)
3470 TL1 := TML↑.REST
3480 END (*OF WHILE*)
3490 END; (*REPLACE*)
3500
3510 PROCEDURE SUBST(X, T:TERM; VAR T1, T2:TERMLIST);
3520 BEGIN
3530 REPLACE(X, T, T1);
3540 REPLACE(X, T, T2)
3550 END;
3560
3570
3580 FUNCTION EQSYM(X,Y:SYMBOL):BOOLEAN;
3590 BEGIN
3600 WHILE X↑.NOTEMPTY AND Y↑.NOTEMPTY AND (X↑.FIRSTCH = Y↑.FIRSTCH) DO
3610 BEGIN
3620 X:=X↑.TAIL;
3630 Y:=Y↑.TAIL
3640 END;
3650 IF X↑.NOTEMPTY OR Y↑.NOTEMPTY
3660 THEN EQSYM:= FALSE
3670 ELSE EQSYM:= TRUE
3680 END;
3690
3700
3710 FUNCTION EQCONST(X,Y:CONSTANT):BOOLEAN;
3720 BEGIN
3730 IF X↑.CTYP = Y↑.CTYP
3740 THEN CASE X↑.CTYP OF
3750 INTEGERTYP: EQCONST:= X↑.IVAL = Y↑.IVAL;
3760 REALTYP: EQCONST:= X↑.RVAL = Y↑.RVAL;
3770 BOOLEANTYP: EQCONST:= X↑.BVAL = Y↑.BVAL;
3780 CHARTYP: EQCONST:= X↑.CVAL = Y↑.CVAL;
3790 SYMBOLTYP: EQCONST:= EQSYM(X↑.SVAL, Y↑.SVAL)
3800 END
3810 ELSE EQCONST:= FALSE
3820 END;
3830
3840
3850 FUNCTION COPYSYM(OLDSYM:SYMBOL):SYMBOL;
3860 VAR NEWSYM, LASTNODE, NEWNODE:SYMBOL;
3870
3880 BEGIN
3890 NEW(NEWSYM);
3900 LASTNODE := NEWSYM;
3910 WHILE OLDSYM↑.NOTEMPTY DO
3920 BEGIN
3930 LASTNODE↑.NOTEMPTY := TRUE;
3940 LASTNODE↑.FIRSTCH := OLDSYM↑.FIRSTCH;
3950 NEW(NEWNODE);
3960 LASTNODE↑.TAIL := NEWNODE;
3970 LASTNODE := NEWNODE;
3980 OLDSYM := OLDSYM↑.TAIL
3990 END;
4000 LASTNODE↑.NOTEMPTY := FALSE;
4010 COPYSYM := NEWSYM
4020 END; (*COPYSYM*)
4030
4040
4050 FUNCTION COPYTERM(OLDTM:TERM):TERM;
4060 FORWARD;
4070
4080
4090 FUNCTION COPYTERMLIST(TML:TERMLIST):TERMLIST;
4100 VAR NEWNODE, LASTNODE, TMLNEW:TERMLIST;
4110
4120 BEGIN
4130 NEW(TMLNEW);
4140 LASTNODE := TMLNEW;
4150 WHILE TML↑.NOTEMPTY DO
4160 BEGIN
4170 LASTNODE↑.NOTEMPTY := TRUE;
4180 LASTNODE↑.FIRST := COPYTERM(TML↑.FIRST);
4190 NEW(NEWNODE);
4200 LASTNODE↑.REST := NEWNODE;
4210 LASTNODE := NEWNODE;
4220 TML := TML↑.REST;
4230 END;
4240 LASTNODE↑.NOTEMPTY := FALSE;
4250 COPYTERMLIST := TMLNEW
4260 END; (*COPYTERMLIST*)
4270
4280
4290 FUNCTION COPYCONST(OLDCONST:CONSTANT):CONSTANT;
4300 VAR NEWCONST:CONSTANT;
4310
4320 BEGIN
4330 NEW(NEWCONST);
4340 NEWCONST↑.CTYP := OLDCONST↑.CTYP;
4350 CASE NEWCONST↑.CTYP OF
4360 INTEGERTYP: NEWCONST↑.IVAL := OLDCONST↑.IVAL;
4370 REALTYP: NEWCONST↑.RVAL := OLDCONST↑.RVAL;
4380 BOOLEANTYP: NEWCONST↑.BVAL := OLDCONST↑.BVAL;
4390 CHARTYP: NEWCONST↑.CVAL := OLDCONST↑.CVAL;
4400 SYMBOLTYP: NEWCONST↑.SVAL := COPYSYM(OLDCONST↑.SVAL)
4410 END; (*OF CASE STMT*)
4420 COPYCONST := NEWCONST
4430 END; (*COPYCONST*)
4440
4450
4460 FUNCTION COPYTERM;
4470 VAR NEWTM:TERM;
4480
4490 BEGIN
4500 NEW(NEWTM);
4510 NEWTM↑.TTYP := OLDTM↑.TTYP;
4520 CASE NEWTM↑.TTYP OF
4530 VARIABLE: NEWTM↑.VR := OLDTM↑.VR; (*IT'S JUST AN INTEGER*)
4540 CONSTANTTYP: NEWTM↑.CNST := COPYCONST(OLDTM↑.CNST);
4550 FUNAPP: BEGIN
4560 NEWTM↑.FNAME := COPYSYM(OLDTM↑.FNAME);
4570 NEWTM↑.ARGS := COPYTERMLIST(OLDTM↑.ARGS)
4580 END
4590 END; (*OF CASE STMT*)
4600 COPYTERM := NEWTM
4610 END; (*COPYTERM*)
4620
4630
4640 (*THE FIRST CALL ON UNIFY WILL REPEAT THE ARGLISTS BEING UNIFIED- DUMB, BUT IT
4650 MAKES IT POSSIBLE TO ACCOMPLISH THE SUBSTITUTIONS BY REPLACEMENT AS WE GO INSTEAD
4660 OF BUILDING A SUBSTITUTION AND MAKING NEW COPIES OF EVERYTHING EVERY TIME WE DO
4670 A SUBSTITUTION. THE ALLX AND ALLY ARGS ARE NECESSARY TO ENSURE THAT ANY REPLACEMENTS
4680 RESULTING FROM RECURSIVE CALLS GET MADE THROUGHOUT THE ENTIRE TERMLISTS YOU STARTED
4690 WITH*)
4700 FUNCTION UNIFY(VAR X, Y, ALLX, ALLY: TERMLIST): BOOLEAN;
4710 VAR X1, Y1: TERMLIST;
4720 X2, Y2: TERM;
4730 DUMMY, FAILED: BOOLEAN;
4740 BEGIN
4750 (*INITIALIZE*)
4760 FAILED := FALSE;
4770 X1 := X;
4780 Y1 := Y;
4790 WHILE X1↑.NOTEMPTY AND Y1↑.NOTEMPTY AND NOT(FAILED) DO
4800 BEGIN
4810 X2 := X1↑.FIRST;
4820 Y2 := Y1↑.FIRST;
4830 IF X2↑.TTYP = VARIABLE
4840 THEN BEGIN
4850 IF Y2↑.TTYP = VARIABLE
4860 THEN X2↑.VR := Y2↑.VR
4870 (* IF THEY'RE ALREADY THE SAME, THE ASSIGNMENT IS UNNECESSARY
4880 BUT CHEAPER THAN TESTING THE EQUALITY AND WON'T HURT ANYTHING*)
4890 ELSE IF OCCUR(X2, Y2)
4900 THEN FAILED := TRUE
4910 ELSE SUBST(X2, Y2, X, Y)
4920 END
4930 ELSE IF Y2↑.TTYP = VARIABLE
4940 THEN BEGIN
4950 IF OCCUR(Y2, X2)
4960 THEN FAILED := TRUE
4970 ELSE SUBST(Y2, X2, X, Y)
4980 END
4990 ELSE IF X2↑.TTYP = CONSTANTTYP
5000 THEN BEGIN
5010 IF Y2↑.TTYP = CONSTANTTYP
5020 THEN BEGIN
5030 IF NOT( EQCONST(X2↑.CNST, Y2↑.CNST) )
5040 THEN FAILED := TRUE;
5050 (*IF THEY ARE = NOTHING NEED BE DONE*)
5060 END
5070 ELSE FAILED := TRUE
5080 END
5090 ELSE (*X2 IS A FUNAPP AND Y2 IS NOT A VARIABLE*)
5100 IF Y2↑.TTYP = CONSTANTTYP
5110 THEN FAILED := TRUE
5120 ELSE (*X2 AND Y2 ARE BOTH FUNAPP TERMS*)
5130 IF EQSYM(X2↑.FNAME, Y2↑.FNAME)
5140 THEN BEGIN
5150 DUMMY :=
5160 UNIFY(X2↑.ARGS, Y2↑.ARGS,
5170 ALLX, ALLY);
5180 IF NOT DUMMY
5190 THEN FAILED := TRUE
5200 END
5210 ELSE FAILED :=TRUE;
5220 X1 := X1↑.REST;
5230 Y1 := Y1↑.REST
5240 END; (*OF WHILE*)
5250 IF X1↑.NOTEMPTY OR Y1↑.NOTEMPTY THEN FAILED := TRUE;
5260 UNIFY := NOT FAILED
5270 END; (*OF UNIFY*)
5280
5290 FUNCTION LESSTHAN(X, Y:TERM; VAR Z:TERM):BOOLEAN;
5300 VAR CON: CONSTANT;
5310 BEGIN
5320 Z↑.TTYP := CONSTANTTYP;
5330 NEW(CON);
5340 Z↑.CNST := CON;
5350 CON↑.CTYP := BOOLEANTYP;
5360 IF X↑.CNST↑.IVAL < Y↑.CNST↑.IVAL
5370 THEN Z↑.CNST↑.BVAL := TRUE
5380 ELSE Z↑.CNST↑.BVAL := FALSE;
5390 LESSTHAN := TRUE
5400 END;
5410
5420 FUNCTION GREATEREQUAL(X, Y:TERM; VAR Z: TERM): BOOLEAN;
5430 VAR CON: CONSTANT;
5440 BEGIN
5450 Z↑.TTYP := CONSTANTTYP;
5460 NEW(CON);
5470 CON↑.CTYP := BOOLEANTYP;
5480 Z↑.CNST := CON;
5490 IF X↑.CNST↑.IVAL >= Y↑.CNST↑.IVAL
5500 THEN Z↑.CNST↑.BVAL := TRUE
5510 ELSE Z↑.CNST↑.BVAL := FALSE;
5520 GREATEREQUAL := TRUE
5530 END;
5540
5550 FUNCTION TIMES(X, Y:TERM; VAR Z:TERM): BOOLEAN;
5560 VAR CON:CONSTANT;
5570 BEGIN
5580 Z↑.TTYP := CONSTANTTYP;
5590 NEW(CON);
5600 CON↑.CTYP := INTEGERTYP;
5610 Z↑.CNST := CON;
5620 CON↑.IVAL := X↑.CNST↑.IVAL * Y↑.CNST↑.IVAL;
5630 TIMES := TRUE
5640 END;
5650
5660 FUNCTION SUB1(X: TERM; VAR Y:TERM):BOOLEAN;
5670 VAR CON:CONSTANT;
5680 BEGIN
5690 Y↑.TTYP := CONSTANTTYP;
5700 NEW(CON);
5710 CON↑.CTYP := INTEGERTYP;
5720 Y↑.CNST := CON;
5730 CON↑.IVAL := X↑.CNST↑.IVAL - 1;
5740 SUB1 := TRUE
5750 END;
5760
5770
5780 PROCEDURE LOOKUP(TM:TERM; TBL: VARPAIRS; FOUND: BOOLEAN);
5790 VAR PTR: VARPAIRS;
5800 BEGIN
5810 FOUND := FALSE;
5820 PTR := TBL;
5830 WHILE PTR↑.NOTEMPTY AND NOT FOUND
5840 DO BEGIN
5850 IF PTR↑.OLD = TM↑.VR
5860 THEN BEGIN
5870 TM↑.VR := PTR↑.NEW;
5880 FOUND := TRUE
5890 END;
5900 PTR := PTR↑.REST
5910 END
5920 END; (*LOOKUP*)
5930
5940
5950 PROCEDURE STANDAPART(TML: TERMLIST; VAR DONETBL: VARPAIRS);
5960 VAR PTR: TERMLIST;
5970 DONE: VARPAIRS;
5980 FOUND: BOOLEAN;
5990 BEGIN
6000 PTR:= TML;
6010 WHILE PTR↑.NOTEMPTY
6020 DO BEGIN
6030 IF PTR↑.FIRST↑.TTYP = VARIABLE
6040 THEN BEGIN
6050 LOOKUP(PTR↑.FIRST, DONETBL, FOUND);
6060 IF NOT FOUND
6070 THEN BEGIN
6080 NEW(DONE);
6090 DONE↑.NOTEMPTY := TRUE;
6100 DONE↑.OLD := PTR↑.FIRST↑.VR;
6110 DONE↑.NEW := GENVAR;
6120 PTR↑.FIRST↑.VR := DONE↑.NEW;
6130 DONE↑.REST := DONETBL;
6140 DONETBL := DONE
6150 END
6160 END
6170 ELSE IF PTR↑.FIRST↑.TTYP = FUNAPP
6180 THEN STANDAPART(PTR↑.FIRST↑.ARGS, DONETBL);
6190 PTR := PTR↑.REST
6200 END
6210 END; (*STANDAPART*)
6220
6230
6240 BEGIN (*JUNK*)
6250 END.
0 ERROR(S) DETECTED
HIGHSEG: 0K + 855 WORD(S)
LOWSEG : 0K + 8 WORD(S)
RUNTIME: 0: 1.100